home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 2614.ZIP / TBROWS.ZIP / TTBR8.PRG < prev    next >
Text File  |  1990-10-26  |  4KB  |  191 lines
  1. /*****
  2.  *
  3.  * TTBR8.PRG
  4.  * Eighth example for TBROWSE class using a database file
  5.  *
  6.  * 22 October 90
  7.  * Luiz Quintela - Nantucket Corp
  8.  *
  9.  * Clipper ttbr8 /N/W/A/B
  10.  * RTLINK FILE ttbr8 PLL base50
  11.  *
  12.  */
  13.  
  14. // Include Header Files
  15. #include "inkey.ch"
  16. #include "setcurs.ch"
  17.  
  18. MEMVAR GetList
  19.  
  20. FUNCTION Main()
  21. LOCAL b, column, nKey, aColors, nCnt, aLowHi
  22. SET SCOREBOARD OFF
  23. SET DATE       BRITISH
  24. SET CONFIRM    ON
  25.  
  26. USE test INDEX test NEW
  27. // Turn cursor off
  28. SETCURSOR(SC_NONE)
  29. SETCOLOR( "BG/B" ); CLS
  30.  
  31. b := TBrowseDB( 2, 2, 20, 48)
  32. b:colorSpec := "BG/B,GR+/R,W/N,N,GR+/W,W+/B,R+/B,GR+/B"
  33.  
  34. b:colSep := " │ "
  35. b:headSep := "═╤═"
  36. b:footSep := "═══"
  37.  
  38. // TBColumn objects
  39. column := TBColumnNew( "Field 1", {|| test->fld1} )
  40. column:footing := "First"
  41. b:addColumn( column )
  42. column := TBColumnNew( "Field 2", {|| test->fld2} )
  43. b:addColumn( column )
  44. column := TBColumnNew( "Field 3", {|| test->fld3} )
  45. b:addColumn( column )
  46. column := TBColumnNew( "Field 4", {|| test->fld4} )
  47. b:addColumn( column )
  48. column := TBColumnNew( "Field 5", {|| test->fld5} )
  49. column:footing := "Last"
  50. b:addColumn( column )
  51.  
  52. // Freeze one column 
  53. b:freeze := 1
  54.  
  55. // cargo
  56. // is an instance variable of ANY DATA TYPE, allowing
  57. // arbitrary information to be attached to a TBrowse object and
  58. // retrieved later
  59. // This is the same principle used in TBColumn:cargo
  60. // But now we will use TBrowse:cargo
  61. b:cargo := {|| ChgClr() }
  62.  
  63. WHILE .T.
  64.    IF  ( b:colPos <= 1 )
  65.        b:colPos := b:freeze + 1
  66.  
  67.    ENDIF
  68.  
  69.    // Stabilization
  70.    WHILE ( !b:stabilize() )
  71.       nKey := InKey()
  72.       IF ( nKey != 0 )
  73.          EXIT // abort if a key is waiting
  74.  
  75.       ENDIF
  76.  
  77.    END
  78.  
  79.    IF ( b:stable )
  80.       IF ( b:hitTop .OR. b:hitBottom )
  81.           TONE(87.3,1)
  82.          TONE(40,3.5)
  83.  
  84.       ENDIF
  85.       nKey := INKEY(0)         
  86.  
  87.    ENDIF
  88.  
  89.    // Process key
  90.     IF ( nKey == K_DOWN )
  91.       b:down()
  92.  
  93.    ELSEIF ( nKey == K_UP )
  94.       b:up()
  95.  
  96.    ELSEIF ( nKey == K_PGDN )
  97.       b:pageDown()
  98.  
  99.    ELSEIF ( nKey == K_PGUP )
  100.       b:pageUp()
  101.  
  102.    ELSEIF ( nKey == K_CTRL_PGUP )
  103.       b:goTop()
  104.  
  105.    ELSEIF ( nKey == K_CTRL_PGDN )
  106.       b:goBottom()
  107.  
  108.    ELSEIF ( nKey == K_RIGHT )
  109.       b:right()
  110.  
  111.    ELSEIF ( nKey == K_LEFT )
  112.       b:left()
  113.  
  114.    ELSEIF ( nKey == K_HOME )
  115.       b:home()
  116.  
  117.    ELSEIF ( nKey == K_END )
  118.       b:end()
  119.  
  120.    ELSEIF ( nKey == K_CTRL_LEFT )
  121.       b:panLeft()
  122.  
  123.    ELSEIF ( nKey == K_CTRL_RIGHT )
  124.       b:panRight()
  125.  
  126.    ELSEIF ( nKey == K_CTRL_HOME )
  127.       b:panHome()
  128.  
  129.    ELSEIF ( nKey == K_CTRL_END )
  130.       b:panEnd()
  131.  
  132.    ELSEIF ( nKey == K_ESC )
  133.         CLS; SETCURSOR(SC_NORMAL); QUIT
  134.  
  135.     ELSEIF ( nKey == K_F10 )
  136.         // Evaluate attached cargo
  137.        aLowHi := EVAL( b:cargo )
  138.  
  139.       // Change all colors
  140.       // Transverse all columns
  141.       // Starting at column 1 up to colCount which contains
  142.       // the total number of data columns in the browse
  143.       FOR nCnt := 1 TO b:colCount
  144.           // getColumn is a method which returns a TBColumn
  145.           // object
  146.           column := b:getColumn( nCnt )
  147.           column:defColor   := { 1, 2 }
  148.           column:colorBlock := { || LineClr( aLowHi ) }
  149.           column:defColor   := { 1, 2 }
  150.           b:setColumn( nCnt, column )
  151.  
  152.       NEXT
  153.  
  154.         b:configure()   // Causes the TBrowse object to 
  155.         // re-examine all instance variables and TBColumn 
  156.         // objects, and them reconfigure its internal settings
  157.         // as required
  158.         b:refreshAll()  // Internally marks all data rows as
  159.         // invalid, causing them to be refilled and redisplayed
  160.         // during the next stabilize loop
  161.  
  162.     ENDIF
  163.  
  164. END
  165.  
  166.  
  167. FUNCTION ChgClr()
  168. LOCAL column, nLow := 1, nHi := 200
  169. LOCAL cScr  := SAVESCREEN( 7, 10, 11, 27 )
  170. LOCAL cClr  := SETCOLOR( "GR+/N,N/GR+" )
  171. LOCAL nCurs := SETCURSOR(SC_NORMAL)
  172. // First, ask for data rows range
  173. @  7,10 CLEAR TO 11,27
  174. @  8,12 SAY "From line:" GET nLow PICTURE "999"
  175. @ 10,12 SAY "To line:"   GET nHi  PICTURE "999"
  176. READ
  177. SETCURSOR(nCurs)
  178. SETCOLOR(cClr)
  179. RESTSCREEN( 7, 10, 11, 27, cScr )
  180. RETURN IF(LASTKEY() == 27, { 1, 200 }, { nLow, nHi } )
  181.  
  182.  
  183. FUNCTION LineClr( aLowHi )
  184. IF RECNO() >= aLowHi[1] .AND. RECNO() <= aLowHi[2]
  185.    RETURN { 6 , 2 }
  186. ELSE
  187.    RETURN { 1, 2 }
  188. ENDIF
  189.  
  190. /* EOF - TBBR8.PRG */
  191.